home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / programming / source / obrn-a_1.5_src.lha / oberon-a / source3.lha / Source / OL / OL.mod next >
Encoding:
Text File  |  1995-01-26  |  25.2 KB  |  932 lines
  1. (*************************************************************************
  2.  
  3.      $RCSfile: OL.mod $
  4.   Description: Recursively scans the symbol files referenced by a module
  5.                and creates a WITH file to be input to a linker.
  6.  
  7.    Created by: fjc (Frank Copeland)
  8.     $Revision: 2.8 $
  9.       $Author: fjc $
  10.         $Date: 1995/01/26 02:07:58 $
  11.  
  12.   Copyright © 1993-1995, Frank Copeland
  13.   This module forms part of the OL program
  14.   See OL.doc for conditions of use and distribution
  15.  
  16.   Log entries are at the end of the file.
  17.  
  18. *************************************************************************)
  19.  
  20. <* STANDARD- *>
  21.  
  22. MODULE OL;
  23.  
  24. IMPORT
  25.   SYS := SYSTEM, Kernel, OLRev, Errors, e := Exec, d := Dos,
  26.   du := DosUtil, str := Strings, str2 := Strings2, f := Files,
  27.   L := Lists, OLSettings, s := OLStrings, u := Utility, wb := Workbench,
  28.   i := Icon, WbConsole;
  29.  
  30. CONST
  31.   CopyrightStr = "Copyright © 1993-1995 Frank Copeland\n";
  32.  
  33. VAR
  34.   startDir : d.FileLockPtr;
  35.  
  36. (*
  37. ** Command line template and parsing
  38. *)
  39.  
  40. CONST
  41.   template =
  42.     "PROG/A,SETTINGS/K,SYMSEARCH/K,OBJSEARCH/K,"
  43.     "WITHPATH/K,PROGPATH/K,SYMEXT/K,OBJEXT/K,WITHEXT/K,"
  44.     "LINKCMD/K,LINKARGS/K,ALINK/S,BLINK/S,DLINK/S,"
  45.     "VERBOSE/S,MAKEICONS/S,QUIET/S,NOICONS/S,SCAN/S,LINK/S";
  46.  
  47.   template2 = "STR/M";
  48.  
  49.   helpStr =
  50.     "See OL.doc for more details\n\n"
  51.     "Arguments ? ";
  52.  
  53.   optPROG      = 0;
  54.   optSETTINGS  = 1;
  55.   optSYMSEARCH = 2;
  56.   optOBJSEARCH = 3;
  57.   optWITHPATH  = 4;
  58.   optPROGPATH  = 5;
  59.   optSYMEXT    = 6;
  60.   optOBJEXT    = 7;
  61.   optWITHEXT   = 8;
  62.   optLINKCMD   = 9;
  63.   optLINKARGS  = 10;
  64.   optALINK     = 11;
  65.   optBLINK     = 12;
  66.   optDLINK     = 13;
  67.   optVERBOSE   = 14;
  68.   optMAKEICONS = 15;
  69.   optQUIET     = 16;
  70.   optNOICONS   = 17;
  71.   optSCAN      = 18;
  72.   optLINK      = 19;
  73.   optCount     = 20;
  74.  
  75. VAR
  76.   rdArgs, rdArgs2 : d.RDArgsPtr;
  77.   args : RECORD [2] (d.ArgsStruct)
  78.     prog,
  79.     settings,
  80.     symsearch,
  81.     objsearch,
  82.     withpath,
  83.     progpath,
  84.     symext,
  85.     objext,
  86.     withext,
  87.     linkcmd,
  88.     linkargs
  89.       : d.ArgString;
  90.     alink,
  91.     blink,
  92.     dlink,
  93.     verbose,
  94.     makeicons,
  95.     quiet,
  96.     noicons,
  97.     scan,
  98.     link
  99.       : d.ArgBool;
  100.   END;
  101.  
  102. CONST
  103.   maxName   = 255;
  104.   maxPath   = 255;
  105.  
  106. TYPE
  107.   NameStr = ARRAY maxName + 1 OF CHAR;
  108.   PathStr = ARRAY maxPath + 1 OF CHAR;
  109.  
  110. (* These are filled in by ParseArgs() *)
  111.  
  112. VAR
  113.   moduleName : NameStr;
  114.   withName, progName : PathStr;
  115.   Scan, Link : BOOLEAN;
  116.  
  117. TYPE
  118.   StringArray = POINTER [2] TO ARRAY MAX(INTEGER) OF e.LSTRPTR;
  119.  
  120. (*
  121. ** Symbol files
  122. *)
  123.  
  124. CONST
  125.   SymTag = 53594D08H; (* Symbol file tag : "SYM" + version # *)
  126.  
  127.   (* terminal symbols for symbol file elements *)
  128.  
  129.   eUndef = 0; eCon = 1; eTypE = 2; eTyp = 3; eVar = 4; eXProc = 5;
  130.   eLibCall = 6; eM2Proc = 7; eCProc = 8; eAProc = 9; ePointer = 10;
  131.   eProcTyp = 11; eArray = 12; eDynArr = 13; eRecord = 14; eParList = 15;
  132.   eValPar = 16; eVarPar = 17; eVarArg = 18; eFldList = 19; eFld = 20;
  133.   eHPtr = 21; eHProc = 22; eTProcE = 23; eTProc = 24; eFixup = 25;
  134.   eMod = 26; eExtLib = 27;
  135.  
  136. (*
  137. ** Module list
  138. *)
  139.  
  140. TYPE
  141.   ModulePtr = POINTER TO Module;
  142.   Module = RECORD (L.NameNode)
  143.     key : LONGINT;
  144.     path : PathStr;
  145.   END; (* Module *)
  146.  
  147. VAR
  148.   moduleList : L.NameList;
  149.  
  150. (*
  151. ** File searching
  152. *)
  153.  
  154. CONST
  155.   maxSearch = 10;
  156.   maxExt    = 10;
  157.  
  158. VAR
  159.   SymSearch, ObjSearch : ARRAY maxSearch + 1 OF e.LSTRPTR;
  160.   SymExt, ObjExt : ARRAY maxExt + 1 OF e.LSTRPTR;
  161.   SymX, ObjX, SymExtX, ObjExtX : INTEGER;
  162.  
  163. (*
  164. ** Icon types
  165. *)
  166.  
  167. CONST
  168.   iconWith = 0; iconProg = 1;
  169.  
  170. (*
  171. ** Console I/O
  172. *)
  173.  
  174. (*------------------------------------*)
  175. PROCEDURE OutStr* ( string : ARRAY OF CHAR );
  176. <*$CopyArrays-*>
  177. BEGIN (* OutStr *)
  178.   du.HaltIfBreak ({d.ctrlC});
  179.   IF d.PutStr (string) = 0 THEN END;
  180. END OutStr;
  181.  
  182.  
  183. (*------------------------------------*)
  184. PROCEDURE OutChar* ( c : CHAR );
  185. BEGIN (* OutChar *)
  186.   du.HaltIfBreak ({d.ctrlC});
  187.   d.PrintF ("%lc", c)
  188. END OutChar;
  189.  
  190.  
  191. (*------------------------------------*)
  192. PROCEDURE OutLn*;
  193. BEGIN (* OutLn *)
  194.   OutChar ("\n")
  195. END OutLn;
  196.  
  197.  
  198. (*------------------------------------*)
  199. PROCEDURE OutStr0* ( n : LONGINT );
  200.   VAR string : e.LSTRPTR;
  201. BEGIN (* OutStr0 *)
  202.   du.HaltIfBreak ({d.ctrlC});
  203.   string := s.GetString (n);
  204.   IF d.PutStr (string^) = 0 THEN END;
  205. END OutStr0;
  206.  
  207.  
  208. (*------------------------------------*)
  209. PROCEDURE OutStr1* ( n : LONGINT; string : ARRAY OF CHAR );
  210.   VAR format : e.LSTRPTR;
  211. <*$CopyArrays-*>
  212. BEGIN (* OutStr1 *)
  213.   du.HaltIfBreak ({d.ctrlC});
  214.   format := s.GetString (n);
  215.   d.PrintF (format^, SYS.ADR (string));
  216. END OutStr1;
  217.  
  218.  
  219. (*------------------------------------*)
  220. PROCEDURE OutBool* ( b : BOOLEAN );
  221. BEGIN (* OutBool *)
  222.   IF b THEN OutStr ("TRUE")
  223.   ELSE OutStr ("FALSE")
  224.   END
  225. END OutBool;
  226.  
  227.  
  228. (*------------------------------------*)
  229. PROCEDURE* Cleanup (VAR rc : LONGINT);
  230.  
  231.   VAR oldDir : d.FileLockPtr;
  232.  
  233. BEGIN (* Cleanup *)
  234.   IF rdArgs # NIL THEN
  235.     d.FreeArgs (rdArgs);
  236.     d.FreeDosObject (d.rdArgs, rdArgs);
  237.     rdArgs := NIL
  238.   END;
  239.   IF rdArgs2 # NIL THEN
  240.     d.FreeDosObject (d.rdArgs, rdArgs2);
  241.     rdArgs2 := NIL
  242.   END;
  243.   s.CloseCatalog();
  244.   IF Kernel.fromWorkbench THEN oldDir := d.CurrentDir (startDir) END
  245. END Cleanup;
  246.  
  247. (*------------------------------------*)
  248. PROCEDURE Init ();
  249.  
  250. BEGIN (* Init *)
  251.   Kernel.SetCleanup (Cleanup);
  252.   s.OpenCatalog (NIL, "");
  253.  
  254.   rdArgs := d.AllocDosObjectTags (d.rdArgs, u.end);
  255.   rdArgs2 := d.AllocDosObjectTags (d.rdArgs, u.end);
  256.   ASSERT ((rdArgs # NIL) & (rdArgs2 # NIL));
  257.   rdArgs.extHelp := SYS.ADR (helpStr);
  258. END Init;
  259.  
  260. (*------------------------------------*)
  261. PROCEDURE CloneStr ( oldStr : e.LSTRPTR ) : e.LSTRPTR;
  262.   VAR newStr : e.LSTRPTR;
  263. BEGIN (* CloneStr *)
  264.   SYS.NEW (newStr, str.Length (oldStr^) + 1);
  265.   COPY (oldStr^, newStr^);
  266.   RETURN newStr
  267. END CloneStr;
  268.  
  269. (*------------------------------------*)
  270. PROCEDURE WbArgs ();
  271.  
  272.   VAR
  273.     wbStartup : wb.WBStartupPtr;
  274.     numArgs   : LONGINT;
  275.     argList   : wb.WBArgumentsPtr;
  276.     oldDir    : d.FileLockPtr;
  277.     diskObj   : wb.DiskObjectPtr;
  278.     toolTypes : wb.ToolTypePtr;
  279.     string    : e.LSTRPTR;
  280.  
  281. BEGIN (* WbArgs *)
  282.   wbStartup := SYS.VAL (wb.WBStartupPtr, Kernel.WBenchMsg);
  283.   numArgs := wbStartup.numArgs;
  284.   argList := wbStartup.argList;
  285.   IF numArgs > 2 THEN OutStr0 (s.msg23); HALT (d.warn) END;
  286.  
  287.   IF i.base # NIL THEN
  288.     (* Attempt to load the icon for OL *)
  289.     startDir := d.CurrentDir (argList[0].lock);
  290.     diskObj := i.GetDiskObject (argList[0].name^);
  291.     IF diskObj # NIL THEN
  292.       toolTypes := diskObj.toolTypes;
  293.       string := i.FindToolType (toolTypes, "PROG");
  294.       IF string # NIL THEN args.prog := CloneStr (string) END;
  295.       string := i.FindToolType (toolTypes, "SETTINGS");
  296.       IF string # NIL THEN args.settings := CloneStr (string) END;
  297.       string := i.FindToolType (toolTypes, "SYMSEARCH");
  298.       IF string # NIL THEN args.symsearch := CloneStr (string) END;
  299.       string := i.FindToolType (toolTypes, "OBJSEARCH");
  300.       IF string # NIL THEN args.objsearch := CloneStr (string) END;
  301.       string := i.FindToolType (toolTypes, "WITHPATH");
  302.       IF string # NIL THEN args.withpath := CloneStr (string) END;
  303.       string := i.FindToolType (toolTypes, "PROGPATH");
  304.       IF string # NIL THEN args.progpath := CloneStr (string) END;
  305.       string := i.FindToolType (toolTypes, "SYMEXT");
  306.       IF string # NIL THEN args.symext := CloneStr (string) END;
  307.       string := i.FindToolType (toolTypes, "OBJEXT");
  308.       IF string # NIL THEN args.objext := CloneStr (string) END;
  309.       string := i.FindToolType (toolTypes, "WITHEXT");
  310.       IF string # NIL THEN args.withext := CloneStr (string) END;
  311.       string := i.FindToolType (toolTypes, "LINKCMD");
  312.       IF string # NIL THEN args.linkcmd := CloneStr (string) END;
  313.       string := i.FindToolType (toolTypes, "LINKARGS");
  314.       IF string # NIL THEN args.linkargs := CloneStr (string) END;
  315.       string := i.FindToolType (toolTypes, "ALINK");
  316.       IF string # NIL THEN args.alink := e.LTRUE END;
  317.       string := i.FindToolType (toolTypes, "BLINK");
  318.       IF string # NIL THEN args.blink := e.LTRUE END;
  319.       string := i.FindToolType (toolTypes, "DLINK");
  320.       IF string # NIL THEN args.dlink := e.LTRUE END;
  321.       string := i.FindToolType (toolTypes, "VERBOSE");
  322.       IF string # NIL THEN args.verbose := e.LTRUE END;
  323.       string := i.FindToolType (toolTypes, "MAKEICONS");
  324.       IF string # NIL THEN args.makeicons := e.LTRUE END;
  325.       string := i.FindToolType (toolTypes, "QUIET");
  326.       IF string # NIL THEN args.quiet := e.LTRUE END;
  327.       string := i.FindToolType (toolTypes, "NOICONS");
  328.       IF string # NIL THEN args.noicons := e.LTRUE END;
  329.       string := i.FindToolType (toolTypes, "SCAN");
  330.       IF string # NIL THEN args.scan := e.LTRUE END;
  331.       string := i.FindToolType (toolTypes, "LINK");
  332.       IF string # NIL THEN args.link := e.LTRUE END;
  333.  
  334.       i.FreeDiskObject (diskObj)
  335.     END
  336.   END;
  337.  
  338.   oldDir := d.CurrentDir (argList[numArgs-1].lock);
  339.   IF args.prog = NIL THEN
  340.     IF numArgs = 2 THEN args.prog := argList[numArgs-1].name
  341.     ELSE OutStr0 (s.msg29); HALT (d.warn)
  342.     END
  343.   END
  344. END WbArgs;
  345.  
  346. (*------------------------------------*)
  347. PROCEDURE CliArgs ();
  348.   VAR ignore : BOOLEAN;
  349. BEGIN (* CliArgs *)
  350.   IF d.ReadArgs (template, args, rdArgs) = NIL THEN
  351.     ignore := d.PrintFault (d.IoErr(), "ReadArgs");
  352.     HALT (d.warn)
  353.   END
  354. END CliArgs;
  355.  
  356. (*------------------------------------*)
  357. PROCEDURE ParseArgs ();
  358.  
  359.   VAR
  360.     ignore : BOOLEAN; ch : CHAR;
  361.     args2 : RECORD [2] (d.ArgsStruct)
  362.       strings : d.ArgStringArray
  363.     END;
  364.  
  365.   (*------------------------------------*)
  366.   PROCEDURE ParseString (s : ARRAY OF CHAR);
  367.  
  368.     VAR len : LONGINT; buffer : e.LSTRPTR;
  369.  
  370.   <*$CopyArrays-*>
  371.   BEGIN (* ParseString *)
  372.     len := str.Length (s) + 2;
  373.     SYS.NEW (buffer, len);
  374.     COPY (s, buffer^);
  375.     buffer [len-2] := "\n"; buffer [len-1] := 0X;
  376.     rdArgs2.source.buffer := buffer;
  377.     rdArgs2.source.length := len - 1;
  378.     rdArgs2.source.curChr := 0;
  379.     rdArgs2.daList := 0; rdArgs2.buffer := NIL; rdArgs2.bufSiz := 0;
  380.     rdArgs2.extHelp := NIL; rdArgs2.flags := {};
  381.     args2.strings := NIL;
  382.     IF d.ReadArgs (template2, args2, rdArgs2) = NIL THEN
  383.       ignore := d.PrintFault (d.IoErr(), "ParseString");
  384.       HALT (d.warn)
  385.     END
  386.   END ParseString;
  387.  
  388.  
  389.   (*------------------------------------*)
  390.   PROCEDURE AddSearchPaths
  391.     ( VAR paths : ARRAY OF e.LSTRPTR;
  392.       VAR pathx : INTEGER;
  393.       limit     : INTEGER;
  394.       errMsg    : INTEGER;
  395.       string    : ARRAY OF CHAR );
  396.  
  397.     VAR i : INTEGER;
  398.  
  399.   <*$CopyArrays-*>
  400.   BEGIN (* AddSearchPaths *)
  401.     paths [0] := NIL; pathx := 0;
  402.     ParseString (string);
  403.     IF args2.strings # NIL THEN
  404.       i := 0;
  405.       WHILE args2.strings [i] # NIL DO
  406.         IF du.DirExists (args2.strings [i]^) THEN
  407.           IF pathx >= (limit-1) THEN OutStr0 (s.msg2); HALT (d.warn) END;
  408.           paths [pathx] := CloneStr (args2.strings [i]);
  409.           INC (pathx)
  410.         ELSE
  411.           OutStr1 (errMsg, args2.strings [i]^); HALT (d.warn)
  412.         END;
  413.         INC (i)
  414.       END;
  415.     END;
  416.     paths [pathx] := SYS.ADR ("OLIB:"); INC (pathx);
  417.     d.FreeArgs (rdArgs2);
  418.   END AddSearchPaths;
  419.  
  420.   (*------------------------------------*)
  421.   PROCEDURE AddExtensions
  422.     ( VAR extensions : ARRAY OF e.LSTRPTR;
  423.       VAR extx       : INTEGER;
  424.       limit          : INTEGER;
  425.       string         : ARRAY OF CHAR );
  426.  
  427.     VAR i : INTEGER;
  428.  
  429.   <*$CopyArrays-*>
  430.   BEGIN (* AddExtensions *)
  431.     extensions [0] := NIL; extx := 0;
  432.     ParseString (string);
  433.     IF args2.strings # NIL THEN
  434.       i := 0;
  435.       WHILE args2.strings [i] # NIL DO
  436.         IF extx >= limit THEN OutStr0 (s.msg7); HALT (d.warn) END;
  437.         extensions [extx] := CloneStr (args2.strings [i]);
  438.         INC (extx);
  439.         INC (i)
  440.       END;
  441.     END;
  442.     d.FreeArgs (rdArgs2);
  443.   END AddExtensions;
  444.  
  445. BEGIN (* ParseArgs *)
  446.   COPY (args.prog^, moduleName);
  447.  
  448.   IF args.settings = NIL THEN ignore := OLSettings.LoadPrefs ("OL.prefs")
  449.   ELSE
  450.     IF ~OLSettings.LoadPrefs (args.settings^) THEN
  451.       OutStr1 (s.msg1, args.settings^);
  452.       HALT (d.warn)
  453.     END
  454.   END;
  455.  
  456.   IF args.symsearch # NIL THEN COPY (args.symsearch^, OLSettings.SymSearch)
  457.   END;
  458.   AddSearchPaths
  459.     (SymSearch, SymX, maxSearch, s.msg3, OLSettings.SymSearch);
  460.  
  461.   IF args.objsearch # NIL THEN COPY (args.objsearch^, OLSettings.ObjSearch)
  462.   END;
  463.   AddSearchPaths
  464.     (ObjSearch, ObjX, maxSearch, s.msg4, OLSettings.ObjSearch);
  465.  
  466.   IF args.withpath # NIL THEN COPY (args.withpath^, OLSettings.WithPath)
  467.   END;
  468.   IF ~du.DirExists (OLSettings.WithPath) THEN
  469.     OutStr1 (s.msg5, OLSettings.WithPath);
  470.     HALT (d.warn)
  471.   END;
  472.  
  473.   IF args.progpath # NIL THEN COPY (args.progpath^, OLSettings.ProgPath)
  474.   END;
  475.   IF ~du.DirExists (OLSettings.ProgPath) THEN
  476.     OutStr1 (s.msg6, OLSettings.ProgPath);
  477.     HALT (d.warn)
  478.   END;
  479.  
  480.   IF args.symext # NIL THEN COPY (args.symext^, OLSettings.SymExt) END;
  481.   AddExtensions (SymExt, SymExtX, maxExt, OLSettings.SymExt);
  482.  
  483.   IF args.objext # NIL THEN COPY (args.objext^, OLSettings.ObjExt) END;
  484.   AddExtensions (ObjExt, ObjExtX, maxExt, OLSettings.ObjExt);
  485.  
  486.   IF args.withext # NIL THEN COPY (args.withext^, OLSettings.WithExt) END;
  487.  
  488.   IF args.linkcmd # NIL THEN COPY (args.linkcmd^, OLSettings.LinkCmd) END;
  489.  
  490.   IF args.linkargs # NIL THEN COPY (args.linkargs^, OLSettings.LinkArgs)
  491.   END;
  492.  
  493.   IF
  494.     ((args.alink = e.LTRUE)
  495.       & ((args.blink = e.LTRUE) OR (args.dlink = e.LTRUE)))
  496.     OR ((args.blink = e.LTRUE)
  497.       & ((args.alink = e.LTRUE) OR (args.dlink = e.LTRUE)))
  498.     OR ((args.dlink = e.LTRUE)
  499.       & ((args.alink = e.LTRUE) OR (args.blink = e.LTRUE)))
  500.   THEN
  501.     OutStr0 (s.msg24); HALT (d.warn)
  502.   ELSIF (args.alink = e.LTRUE) THEN OLSettings.WithFmt := OLSettings.ALink
  503.   ELSIF (args.blink = e.LTRUE) THEN OLSettings.WithFmt := OLSettings.BLink
  504.   ELSIF (args.dlink = e.LTRUE) THEN OLSettings.WithFmt := OLSettings.DLink
  505.   END;
  506.  
  507.   IF (args.verbose = e.LTRUE) & (args.quiet = e.LTRUE) THEN
  508.     OutStr0 (s.msg25); HALT (d.warn)
  509.   ELSIF (args.verbose = e.LTRUE) THEN OLSettings.Verbose := TRUE
  510.   ELSIF (args.quiet = e.LTRUE) THEN OLSettings.Verbose := FALSE
  511.   END;
  512.  
  513.   IF (args.makeicons = e.LTRUE) & (args.noicons = e.LTRUE) THEN
  514.     OutStr0 (s.msg26); HALT (d.warn)
  515.   ELSIF (args.makeicons = e.LTRUE) THEN OLSettings.MakeIcons := TRUE
  516.   ELSIF (args.noicons = e.LTRUE) THEN OLSettings.MakeIcons := FALSE
  517.   END;
  518.  
  519.   Scan := (args.scan = e.LTRUE);
  520.   Link := (args.link = e.LTRUE);
  521.  
  522.   COPY (OLSettings.WithPath, withName);
  523.   IF d.AddPart (withName, moduleName, LEN (withName)) THEN
  524.     str.Append (OLSettings.WithExt, withName)
  525.   ELSE
  526.     OutStr0 (s.msg9); HALT (d.warn)
  527.   END;
  528.  
  529.   COPY (OLSettings.ProgPath, progName);
  530.   IF ~d.AddPart (progName, moduleName, LEN (progName)) THEN
  531.     OutStr0 (s.msg22); HALT (d.warn)
  532.   END
  533. END ParseArgs;
  534.  
  535. (*------------------------------------*)
  536. PROCEDURE MakeIcon ( file : ARRAY OF CHAR; type : INTEGER );
  537.  
  538.   VAR
  539.     icon, defIcon : PathStr;
  540.     diskObj : wb.DiskObjectPtr;
  541.  
  542. <*$CopyArrays-*>
  543. BEGIN (* MakeIcon *)
  544.   IF OLSettings.MakeIcons THEN
  545.     ASSERT (i.base # NIL, 100);
  546.     COPY (file, icon); str.Append (".info", icon);
  547.     IF ~du.FileExists (icon) THEN
  548.       CASE type OF
  549.         iconWith : COPY ("ENV:OL/def_with", defIcon) |
  550.         iconProg : COPY ("ENV:OL/def_prog", defIcon) |
  551.       END;
  552.       diskObj := i.GetDiskObject (defIcon);
  553.       IF diskObj = NIL THEN
  554.         IF type = iconWith THEN diskObj := i.GetDefDiskObject (wb.project)
  555.         ELSE diskObj := i.GetDefDiskObject (wb.tool)
  556.         END
  557.       END;
  558.       IF diskObj # NIL THEN
  559.         diskObj.currentX := wb.noIconPosition;
  560.         diskObj.currentY := wb.noIconPosition;
  561.         IF ~i.PutDiskObject (file, diskObj) THEN
  562.           IF d.PrintFault (d.IoErr(), "PutDiskObject") THEN END;
  563.           OutStr1 (s.msg27, icon)
  564.         END;
  565.         i.FreeDiskObject (diskObj)
  566.       ELSE
  567.         IF d.PrintFault (d.IoErr(), "GetDiskObject") THEN END;
  568.         OutStr0 (s.msg28)
  569.       END
  570.     END
  571.   END
  572. END MakeIcon;
  573.  
  574.  
  575. (*------------------------------------*)
  576. PROCEDURE Main ();
  577.  
  578.   (*------------------------------------*)
  579.   PROCEDURE Process (modName : ARRAY OF CHAR; key : LONGINT);
  580.  
  581.     VAR
  582.       name : NameStr; symPath, objPath : PathStr;
  583.       node : L.NodePtr; module : ModulePtr;
  584.       symFile : f.File; r : f.Rider;
  585.       si : SHORTINT; i : INTEGER; l, modKey : LONGINT; ch : CHAR;
  586.  
  587.     (*------------------------------------*)
  588.     PROCEDURE ReadName (VAR n : ARRAY OF CHAR);
  589.  
  590.       VAR i : SHORTINT; ch : CHAR;
  591.  
  592.     BEGIN (* ReadName *)
  593.       i := 0;
  594.       LOOP
  595.         f.Read (r, ch); n [i] := ch;
  596.         IF ch = 0X THEN EXIT END;
  597.         INC (i);
  598.         IF i > maxName THEN OutStr1 (s.msg10, symPath); HALT (d.warn) END
  599.       END
  600.     END ReadName;
  601.  
  602.     (*------------------------------------*)
  603.     PROCEDURE ReadModAnchor
  604.       ( VAR k : LONGINT;
  605.         VAR n : ARRAY OF CHAR );
  606.  
  607.     BEGIN (* ReadModAnchor *)
  608.       f.ReadBytes (r, k, 4); (* key *)
  609.       ReadName (n)
  610.     END ReadModAnchor;
  611.  
  612.     (*------------------------------------*)
  613.     PROCEDURE NewModule
  614.       ( name, path : ARRAY OF CHAR;
  615.         key : LONGINT );
  616.  
  617.       VAR module : ModulePtr;
  618.  
  619.     <*$CopyArrays-*>
  620.     BEGIN (* NewModule *)
  621.       NEW (module); module.Name (name);
  622.       module.key := key; COPY (path, module.path);
  623.       moduleList.AddTail (module)
  624.     END NewModule;
  625.  
  626.     (*------------------------------------*)
  627.     PROCEDURE Search
  628.       ( VAR paths, extensions : ARRAY OF e.LSTRPTR;
  629.         name : ARRAY OF CHAR;
  630.         VAR path : ARRAY OF CHAR )
  631.       : BOOLEAN;
  632.  
  633.       VAR temp : NameStr; i : INTEGER;
  634.  
  635.     BEGIN (* Search *)
  636.       i := 0;
  637.       LOOP
  638.         IF extensions [i] = NIL THEN RETURN FALSE END;
  639.         COPY (name, temp); str.Append (extensions [i]^, temp);
  640.         IF du.Search (paths, temp, path) THEN RETURN TRUE END;
  641.         INC (i)
  642.       END
  643.     END Search;
  644.  
  645.   <*$CopyArrays-*>
  646.   BEGIN (* Process *)
  647.     node := moduleList.Find (modName);
  648.     IF node = NIL THEN
  649.       IF Search (SymSearch, SymExt, modName, symPath) THEN
  650.         IF Search (ObjSearch, ObjExt, modName, objPath) THEN
  651.           symFile := f.Old (symPath);
  652.           IF symFile = NIL THEN OutStr1 (s.msg11, symPath); HALT (d.warn)
  653.           END;
  654.  
  655.           OutStr ("\x9B\x4B << "); OutStr (symPath); OutChar (0DX);
  656.           f.Set (r, symFile, 0);
  657.           f.ReadBytes (r, l, 4); (* Symbol file tag *)
  658.           IF l # SymTag THEN OutStr1 (s.msg12, symPath); HALT (d.warn)
  659.           END;
  660.  
  661.           f.Read (r, si);
  662.           IF si # eMod THEN OutStr1 (s.msg13, symPath); HALT (d.warn)
  663.           END;
  664.  
  665.           ReadModAnchor (modKey, name);
  666.           IF str2.CompareCAP (modName, name) # 0 THEN
  667.             OutStr1 (s.msg14, symPath); HALT (d.warn)
  668.           END;
  669.           IF (key # 0) & (key # modKey) THEN
  670.             OutStr1 (s.msg15, symPath); HALT (d.warn)
  671.           END;
  672.           NewModule (modName, objPath, modKey);
  673.  
  674.           LOOP
  675.             f.Read (r, si);
  676.             IF si # eMod THEN EXIT END;
  677.             ReadModAnchor (modKey, name);
  678.             Process (name, modKey)
  679.           END;
  680.  
  681.           WHILE si = eExtLib DO
  682.             ReadName (name);
  683.             node := moduleList.Find (name);
  684.             IF node = NIL THEN
  685.               IF ~du.Search (ObjSearch, name, objPath) THEN
  686.                 OutStr1 (s.msg21, objPath); HALT (d.warn)
  687.               END;
  688.               NewModule (name, objPath, 0)
  689.             END;
  690.             f.Read (r, si)
  691.           END;
  692.  
  693.           f.Set (r, NIL, 0); f.Close (symFile)
  694.         ELSE
  695.           OutStr1 (s.msg16, modName); HALT (d.warn)
  696.         END
  697.       ELSE
  698.         OutStr1 (s.msg17, modName); HALT (d.warn)
  699.       END
  700.     ELSE
  701.       IF (key # 0) & (node (ModulePtr).key # key) THEN
  702.         OutStr1 (s.msg18, modName); HALT (d.warn)
  703.       END
  704.     END
  705.   END Process;
  706.  
  707.   (*------------------------------------*)
  708.   PROCEDURE Output ();
  709.  
  710.     VAR
  711.       withFile : f.File; w : f.Rider;
  712.       module : L.NodePtr; ch : CHAR;
  713.  
  714.     (*------------------------------------*)
  715.     PROCEDURE Indent ();
  716.     BEGIN (* Indent *)
  717.       f.Write (w, " "); f.Write (w, " ")
  718.     END Indent;
  719.  
  720.     (*------------------------------------*)
  721.     PROCEDURE WriteStr (string : ARRAY OF CHAR);
  722.     <*$CopyArrays-*>
  723.     BEGIN (* WriteStr *)
  724.       f.WriteBytes (w, string, str.Length (string))
  725.     END WriteStr;
  726.  
  727.     (*------------------------------------*)
  728.     (*
  729.       Produces a .with file with the format:
  730.  
  731.       FROM <moduleName>.obj
  732.       LIBRARY <first imported module>*
  733.         {<other imported modules>*}
  734.       TO <moduleName>
  735.  
  736.     *)
  737.     PROCEDURE OutputALink ();
  738.  
  739.     BEGIN (* OutputALink *)
  740.       f.Set (w, withFile, 0);
  741.       module := moduleList.head;
  742.       WriteStr ("FROM ");
  743.       WriteStr (module(ModulePtr).path); f.Write (w, "\n");
  744.       module := module.succ;
  745.       WriteStr ("LIBRARY "); WriteStr (module(ModulePtr).path);
  746.       module := module.succ;
  747.       WHILE module # NIL DO
  748.         f.Write (w, "*"); f.Write (w, "\n");
  749.         Indent (); WriteStr (module(ModulePtr).path);
  750.         module := module.succ
  751.       END;
  752.       f.Write (w, "\n"); WriteStr ("TO ");
  753.       WriteStr (progName); f.Write (w, "\n");
  754.       f.Set (w, NIL, 0);
  755.     END OutputALink;
  756.  
  757.     (*------------------------------------*)
  758.     (*
  759.       Produces a .with file with the format:
  760.  
  761.       FROM
  762.         <moduleName>.Obj
  763.       LIBRARY
  764.         {<imported modules>}
  765.       TO
  766.         <moduleName>
  767.  
  768.     *)
  769.     PROCEDURE OutputBLink ();
  770.  
  771.     BEGIN (* OutputBLink *)
  772.       f.Set (w, withFile, 0);
  773.       module := moduleList.head;
  774.       WriteStr ("FROM\n");
  775.       Indent (); WriteStr (module(ModulePtr).path); f.Write (w, "\n");
  776.       module := module.succ;
  777.       WriteStr ("LIBRARY\n");
  778.       WHILE module # NIL DO
  779.         Indent (); WriteStr (module(ModulePtr).path); f.Write (w, "\n");
  780.         module := module.succ
  781.       END;
  782.       WriteStr ("TO\n");
  783.       Indent (); WriteStr (progName); f.Write (w, "\n");
  784.       f.Set (w, NIL, 0);
  785.     END OutputBLink;
  786.  
  787.     (*------------------------------------*)
  788.     (*
  789.       Produces a .with file with the format:
  790.  
  791.       <moduleName>.Obj
  792.       {<imported modules>}
  793.     *)
  794.     PROCEDURE OutputDLink ();
  795.  
  796.     BEGIN (* OutputDLink *)
  797.       f.Set (w, withFile, 0);
  798.       module := moduleList.head;
  799.       WHILE module # NIL DO
  800.         WriteStr (module(ModulePtr).path); f.Write (w, "\n");
  801.         module := module.succ
  802.       END;
  803.       f.Set (w, NIL, 0);
  804.     END OutputDLink;
  805.  
  806.   BEGIN (* Output *)
  807.     withFile := f.New (withName);
  808.     IF withFile # NIL THEN
  809.       IF OLSettings.WithFmt = OLSettings.ALink THEN OutputALink ()
  810.       ELSIF OLSettings.WithFmt = OLSettings.BLink THEN OutputBLink ()
  811.       ELSE OutputDLink ()
  812.       END;
  813.       f.Register (withFile);
  814.       OutStr ("\x9B\x4B >> "); OutStr (withName); OutLn;
  815.       IF OLSettings.MakeIcons THEN MakeIcon (withName, iconWith) END
  816.     ELSE
  817.       OutStr1 (s.msg19, withName)
  818.     END
  819.   END Output;
  820.  
  821.   (*------------------------------------*)
  822.   PROCEDURE DoLink ();
  823.  
  824.     VAR command : ARRAY 256 OF CHAR;
  825.  
  826.   BEGIN (* DoLink *)
  827.     IF OLSettings.LinkCmd # "" THEN COPY (OLSettings.LinkCmd, command)
  828.     ELSIF OLSettings.WithFmt = OLSettings.ALink THEN command := "ALink"
  829.     ELSIF OLSettings.WithFmt = OLSettings.BLink THEN command := "BLink"
  830.     ELSE (* OLSettings.WithFmt = OLSettings.DLink *) command := "dlink"
  831.     END;
  832.     IF OLSettings.WithFmt = OLSettings.DLink THEN
  833.       str.Append (" -o ", command);
  834.       str.Append (progName, command);
  835.       str.Append (" @", command)
  836.     ELSE
  837.       str.Append (" WITH ", command)
  838.     END;
  839.     str.Append (withName, command);
  840.     IF OLSettings.LinkArgs # "" THEN
  841.       str.Append (" ", command); str.Append (OLSettings.LinkArgs, command)
  842.     END;
  843.     IF d.SystemTags (command, 0) = 0 THEN
  844.       IF OLSettings.MakeIcons THEN MakeIcon (progName, iconProg) END
  845.     ELSE
  846.       OutStr1 (s.msg20, command)
  847.     END
  848.   END DoLink;
  849.  
  850. BEGIN (* Main *)
  851.   OutStr (OLRev.vString);
  852.   OutStr (CopyrightStr);
  853.   OutStr0 (s.msg8);
  854.   OutLn;
  855.  
  856.   IF Kernel.fromWorkbench THEN WbArgs()
  857.   ELSE CliArgs()
  858.   END;
  859.   ParseArgs();
  860.  
  861.   IF OLSettings.Verbose THEN
  862.     OutStr ("Program  : "); OutStr (progName); OutLn;
  863.     OutStr ("Linker   : ");
  864.     CASE OLSettings.WithFmt OF
  865.       OLSettings.ALink : OutStr ("ALink") |
  866.       OLSettings.BLink : OutStr ("BLink") |
  867.       OLSettings.DLink : OutStr ("DLink") |
  868.     END;
  869.     OutLn;
  870.   END;
  871.  
  872.   IF Scan THEN
  873.     IF OLSettings.Verbose THEN OutLn; OutStr ("Scanning..."); OutLn; END;
  874.     Process (moduleName, 0);
  875.     Process ("Kernel", 0);
  876.     Output ();
  877.     OutLn
  878.   END;
  879.  
  880.   IF Link THEN
  881.     IF OLSettings.Verbose THEN
  882.       OutStr ("LinkCmd  : "); OutStr (OLSettings.LinkCmd); OutLn;
  883.       OutStr ("LinkArgs : "); OutStr (OLSettings.LinkArgs); OutLn; OutLn;
  884.       OutStr ("Linking..."); OutLn
  885.     END;
  886.     DoLink ()
  887.   END
  888. END Main;
  889.  
  890. BEGIN (* OL *)
  891.   ASSERT (e.SysBase.libNode.version >= 37);
  892.   Errors.Init;
  893.   Init ();
  894.   Main ()
  895. END OL.
  896.  
  897. (***************************************************************************
  898.  
  899.   $Log: OL.mod $
  900.   Revision 2.8  1995/01/26  02:07:58  fjc
  901.   - Release 1.5
  902.  
  903.   Revision 2.7  1995/01/09  14:48:31  fjc
  904.   - Modified console output.
  905.   - Removed icon name arguments from command line.
  906.   - Implemented Workbench arguments.
  907.   - Added MakeIcon() to create icons for .with files and
  908.     programs.
  909.  
  910.   Revision 2.6  1995/01/06  16:32:19  fjc
  911.   - Now uses ReadArgs() to process command line arguments.
  912.   - Completely new command line template with numerous options.
  913.   - Loads settings from preferences file.
  914.   - Seperate search paths for symbol and object files.
  915.   - Multiple extensions for symbol and object files supported.
  916.   - Improved support for Matt Dillon's dlink.
  917.  
  918.   Revision 2.5  1994/11/17  11:38:35  fjc
  919.   - Uses Out instead of StdIO.
  920.   - Uses new Strings modules.
  921.  
  922.   Revision 2.4  1994/09/25  18:29:32  fjc
  923.   - Uses new syntax for external code declarations
  924.  
  925.   Revision 2.3  1994/09/03  16:30:49  fjc
  926.   - Gets version string from OLRev.
  927.  
  928.   Revision 2.1  1994/07/03  14:59:27  fjc
  929.   - Added option to call linker direct from OL.
  930.  
  931. ***************************************************************************)
  932.